home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / pascal / tpl60n19.zip / ARISOURC.ZIP / F48FLOG.ASM < prev    next >
Assembly Source File  |  1993-01-24  |  8KB  |  174 lines
  1.  
  2. ; *******************************************************
  3. ; *                                                     *
  4. ; *     Turbo Pascal Runtime Library Version 6.0        *
  5. ; *     Real Logarithm                                  *
  6. ; *                                                     *
  7. ; *     Copyright (C) 1989-1992 Norbert Juffa           *
  8. ; *                                                     *
  9. ; *******************************************************
  10.  
  11.              TITLE   F48FLOG
  12.  
  13.              INCLUDE SE.ASM
  14.  
  15.  
  16. CODE         SEGMENT BYTE PUBLIC
  17.  
  18.              ASSUME  CS:CODE
  19.  
  20. ; Externals
  21.  
  22.              EXTRN   RealAdd:NEAR,CmpMantissa:NEAR,RealFloat:NEAR,RealSub:NEAR
  23.              EXTRN   RealDivRev:NEAR,RealMulNoChk:NEAR,RealPoly:NEAR
  24.              EXTRN   HaltError:NEAR,ROverflow:NEAR,realmulfnochk:near
  25.              EXTRN   ShortMulRev:NEAR
  26. ; Publics
  27.  
  28.              PUBLIC  RLn
  29.  
  30.              IFDEF   EXTENSIONS
  31.              PUBLIC  RLog2,RLog10
  32.              ENDIF
  33.  
  34. ;-------------------------------------------------------------------------------
  35. ; RLn computes the natural logarithm of its argument. It uses a polynomial
  36. ; approximation to compute the natural logarithm of the reduced argument z. The
  37. ; reduced argument satisfies the inequality |z| <= (sqrt(2)-1)^2. RLog10 and
  38. ; RLog2 are additional routines that compute the logarithms base two and ten,
  39. ; respectively. Both first execute RLn to compute the natural logarithm and
  40. ; then proceed to multiply the result with the appropriate constants to get
  41. ; Log10 and Log2. The following polynomial approximation is used to compute
  42. ; the natural logarithm:
  43. ;
  44. ; rz := ((((0.09790802001953*z^2 + 0.1108818338371)*z^2 + 0.1428605246897)*z^2
  45. ;           0.1999999783036)*z^2 + 0.3333333333786)*z^2 * z + z
  46. ;
  47. ; This approximation has a theoretical maximum relative error of 3.20e-14.
  48. ; Maximum observed error when evaluated in REAL arithmetic is 9.31e-13.
  49. ;
  50. ; If the argument is negative or zero, runtime error 207 is invoked through the
  51. ; error handler.
  52. ;
  53. ; INPUT:     DX:BX:AX  argument
  54. ;
  55. ; OUTPUT:    DX:BX:AX  ln, log10, log2 of argument depending on routine called
  56. ;
  57. ; DESTROYS:  AX,BX,CX,DX,SI,DI,Flags
  58. ;-------------------------------------------------------------------------------
  59.  
  60.              IFDEF   EXTENSIONS
  61.  
  62. RLog10       PROC    FAR
  63.              MOV     DI,OFFSET $log_ten; push address of log10 tail-routine
  64.              JMPS    $start_log        ; compute common logarithm
  65. RLog10       ENDP
  66.  
  67.              ALIGN   4
  68.  
  69. RLog2        PROC    FAR
  70.              MOV     DI,OFFSET $log_two; push address of log2 tail-routine
  71.              JMPS    $start_log        ; compute logarithm dualis
  72. RLog2        ENDP
  73.  
  74.              ENDIF
  75.  
  76.              ALIGN   4
  77.  
  78. RLn          PROC    FAR
  79.              MOV     DI,OFFSET $log_end; push address of ln tail-routine
  80. $start_log:  OR      DH, DH            ; x negative ?
  81.              JS      $range_err        ; yes, error
  82.              OR      AL, AL            ; x zero ?
  83.              JZ      $range_err        ; yes, error
  84.              PUSH    DI                ; save log routine tail address
  85.              MOV     CX, 0FA81h        ; CL = exponent of constant a = 1,
  86.              MOV     SI, 0F333h        ;  DI:SI:CH = mantissa
  87.              MOV     DI, 03504h        ;   of 0.5*sqrt(2)
  88.              CALL    CmpMantissa       ; compare mantissas of x and 0.5*sqrt(2)
  89.              JNC     $gt_root2         ; if mantissa x > mantissa 0.5*sqrt(2)
  90.              DEC     CX                ; exponent of constant a = 0.5
  91.              DEC     AX                ; exponent = exponent - 1
  92. $gt_root2:   PUSH    AX                ; save exponent of x
  93.              MOV     AL, 80h           ; x = mantissa of x
  94.              XOR     CH, CH            ; clear LSB of constant a
  95.              PUSH    CX                ; save exponent of constant a
  96.              XOR     SI, SI            ; real constant
  97.              MOV     DI, SI            ;  a = 1 or a = 0.5
  98.              CALL    RealSub           ; x-a
  99.              POP     CX                ; get exponent of constant a
  100.              PUSH    DX                ; save
  101.              PUSH    BX                ;  x-a
  102.              PUSH    AX                ;   on stack
  103.              INC     CX                ; create
  104.              XOR     SI, SI            ;  constant
  105.              MOV     DI, SI            ;   2a
  106.              CALL    RealAdd           ; compute (x-a) + 2a = x+a
  107.              POP     CX                ; get
  108.              POP     SI                ;  back
  109.              POP     DI                ;   x-a
  110.              CALL    RealDivRev        ; compute (x-a)/(x+a)
  111.              MOV     CX, 5             ; polynomial has five coefficients
  112.              MOV     DI,OFFSET LN_COEFF; pointer to first coefficient
  113.              XOR     SI, SI            ; polynomial of type P(x^2)*x+x
  114.              CALL    RealPoly          ; z+z*p(z^2), max. rel. err. 2.6e-12
  115.              ADD     AL, 0FFh          ; compute rz := 2 * (z + z * p(^2))
  116.              ADC     AL, 1             ;  except when result is zero
  117.              POP     CX                ; get exponent
  118.              PUSH    DX                ; save
  119.              PUSH    BX                ;  rz on
  120.              PUSH    AX                ;   stack
  121.              XCHG    AX, CX            ; AL = exponent
  122.              SUB     AL, 80h           ; compute n = exponent - $80
  123.              CBW                       ; convert n to word
  124.              CWD                       ; convert n to longint
  125.              CALL    RealFloat         ; compute float (n)
  126.              MOV     CX, 0D280h        ; load
  127.              MOV     SI, 017F7h        ;  real constant
  128.              MOV     DI, 03172h        ;   ln(2)
  129.              CALL    ShortMulRev       ; compute n*ln(2),max. rel. err. 1.12e-12
  130.              POP     CX                ; get
  131.              POP     SI                ;  rz from
  132.              POP     DI                ;   stack
  133.              JMP     RealAdd           ; compute rz + n * ln(2)
  134.  
  135.              IFDEF   NOOVERFLOW
  136.  
  137. $range_err:  MOV     CH, -1            ; result negativ
  138.              JMP     ROverflow         ; largest REAL number
  139.  
  140.              ELSE
  141.  
  142. $range_err:  MOV     AX, 0CFh          ; load error code 207
  143.              JMP     HaltError         ; execute error handler
  144.  
  145.              ENDIF
  146.  
  147.              IFDEF   EXTENSIONS
  148. $log_ten:    MOV     CX, 0377Fh        ; load
  149.              MOV     SI, 0D8A9h        ;  constant
  150.              MOV     DI, 05E5Bh        ;   1/ln(10)
  151.              JMPS    $mult_const       ; compute common log from natural log
  152. $log_two:    MOV     CX, 05C81h        ; load
  153.              MOV     SI, 03B29h        ;  constant
  154.              MOV     DI, 038AAh        ;   1/ln(2)
  155. $mult_const: CALL    RealMulNoChk      ; compute log dualis from natural log
  156.              ENDIF
  157.  
  158.              ALIGN   4
  159.  
  160. $log_end:    RET                       ; done
  161.  
  162. LN_COEFF     DB      07Dh,               084h,048h  ;  9.790802001953e-2
  163.              DB      07Dh,068h,0D0h,003h,016h,063h  ;  1.108818338371e-1
  164.              DB      07Eh,0BAh,085h,007h,04Ah,012h  ;  1.428605246897e-1
  165.              DB      07Eh,00Fh,058h,0CBh,0CCh,04Ch  ;  1.999999783036e-1
  166.              DB      07Fh,00Eh,0ABh,0AAh,0AAh,02Ah  ;  3.333333333786e-1
  167. RLn          ENDP
  168.  
  169.              ALIGN   4
  170.  
  171. CODE         ENDS
  172.  
  173.              END
  174.